; colortable mod for pdf files
; fonts & directories
; make
; files


#|
 | Compile and Make Functions moved to devlopr1.lsp
 |#


(defun load-distributor ())
(defun make-distrib ())
(defun compile-vista-base-file-dialog ())
(defun compile-exit () (vista-exit))
(defun make-vista (&key exit))
(defun get-compiler-system ())
(defun compile-vista-file (file))
(defun compile-vista-base ())
(defun compile-vista-base-file (file))
(defun initialize-vista-workspace ())
(defun add-distribution-item ())
(defun make-distribution (&rest args))

( defun load-colortable ( &optional (path (strcat *default-path* "pdf" 
*separator* "rgb.txt")))
        (setf path (probe-file path))
        (when (null path)
           (message-dialog "Where is rgb.txt?" )
           (setf path ( open-file-dialog ))
           (if (null path) (return) (setf path (probe-file path))))
        (when path
                (setf *colortable*
                        (list2table (parse-rgb.txt path)))
                #+macintosh ( progn
;; macintosh built-in 'GREEN isn't a pure green
;; we can't redefine standard colors, so we patch the value
;; in the table, so we get the correct Mac value from parse-color,
;; and create a real GREEN green ( named GREENGREEN )
                        (setf (gethash 'GREEN *colortable*) (LIST 0.0 0.6 0.0))
                        (make-color 'GREENGREEN  0.0  1.0  0.0))
        *colortable* ))

(defun rename-wks ()
  (let* ((filename (strcat *default-path* "XLisp.wks"))
         (flag (probe-file filename))
         (loc) (newname)
         )
    (when flag
          (setf loc (position #\. (reverse filename) :test 'equal))
          (setf newname (strcat (reverse (select (reverse filename) 
                     (iseq loc (1- (length filename))))) "bak"))
          (rename-file filename newname))
    newname))


(defun rename-ini ()
  (let ((filename (locate-ini))
        (newname)(loc))
    (when filename
          (setf loc (position #\. (reverse filename) :test 'equal))
          (setf newname (strcat (reverse (select (reverse filename) 
                                         (iseq loc (1- (length filename)))))
                                "bak"))
          (rename-file filename newname))
    newname))

(defun refresh-vista () (restart-vista))

(defun restart-vista (&optional dir)
  (save-all-prefs)
  (if dir
      (system (strcat dir "vista.exe"))
      (system (strcat *default-path* "vista.exe")))
  (exit))

(defun simulated-restart-vista ()
  (write-prefload-file)
  (hide-desktop)
  (load "statinit.lsp")
  )

(defun simulated-install-vista ()
  (write-initial-file t)
  (write-prefload-file)
  (hide-desktop)
  (load "statinit.lsp")
  )

(defun make-xls ()
  (write-prefload-file)
  (double-dribble)
  (set-working-directory *default-path*)
  (rename-wks)
  (rename-file "init.lsp" "inittemp.lsp")
  (rename-file "initxls.lsp" "init.lsp")
  (system "vista.exe")
  (exit))

(defun remake-workspace ()
  (set-working-directory *default-path*)
  (rename-ini)
  (rename-wks)
  (double-dribble)
  (save-all-prefs)
  (system (strcat "vista.exe -f maketime" separator "maker.lsp"))
  (exit))


(defun get-next-log-filename ()
  (setf *log-number* (if *log-number* (1+ *log-number*) 0))
     (strcat *default-path* "log" (format nil "~a" *log-number*) ".log"))

(defun get-next-build-filename ()
  (setf *build-number* (if *build-number* (1+ *build-number*) 0))
     (strcat *default-path* "build" (format nil "~a" *build-number*) ".log"))

(defun find-default-path ()
  (when (or (= (length *default-path*) 0) (not *default-path*))
          (message-dialog (format nil "*default-path* is ~a~% It is being set to ~a."
            (if (not *default-path*) "undefined." (strcat "bad. " *default-path*)) (strcat (get-working-directory) "\\")))
          (setf *default-path* (strcat (get-working-directory) "\\"))
          )
  *default-path*)


(defun locate-ini ()
  (let* ((filename)
         (winexe (if (probe-file (strcat (get-working-directory) "\\wxls32.ini"))
                     (setf filename (strcat (get-working-directory) "\\wxls32.ini"))))
         (windefault (if (and (not filename)
                              (probe-file (strcat *default-path* "wxls32.ini")))
                         (setf filename (strcat *default-path* "wxls32.ini"))))
         (win9598 (if (and (not filename)
                           (probe-file "c:\\windows\\wxls32.ini"))
                      (setf filename "c:\\windows\\wxls32.ini")))
         (winnt   (if (and (not filename)
                           (probe-file "c:\\winnt\\wxls32.ini"))
                      (setf filename "c:\\winnt\\wxls32.ini")))
         )
    filename))


(defun run-exe (helper.exe name.exe &optional command-string)
  (when (not (system (strcat helper.exe " " command-string)))
        (one-button-dialog 
         (strcat "Please Use the next Dialog to Locate " 
                 (string-upcase name.exe)))
        (setf helper.exe (open-file-dialog helper.exe ".exe"))
        (break)
        (system (strcat "\""helper.exe " " command-string "\""))
        helper.exe ))



(defun user-id ()
    (apply #'format nil "~A~A-~A~A~A-~A-~A~A~A-~A" 
           (combine (get-decoded-time-list)
                    (format nil "~d" 
                            (first (floor (+ 1000 (* 8999 (uniform-rand 1)))))))))



#-macintosh
(defun front-window ()
"pseudo-front-window function: front window is returned, but only if window has an installed menu." 
  (let* ((front-menu (front-menu))
         (active-graph-windows (active-graph-windows))
         (menus-of-active-graph-windows
          (mapcar #'(lambda (w) (send w :menu)) active-graph-windows))
         (position-of-front-menu)
         (front-window))
    (when front-menu
          (setf position-of-front-menu (position front-menu menus-of-active-graph-windows))
          (when position-of-front-menu
                (setf front-window (select active-graph-windows position-of-front-menu))))
    front-window))


#-macintosh
(defun front-menu ()
  (first
   (mapcar #'(lambda (i)
               (let ((object (nth 2 i)))
                 (when (and (kind-of-p object menu-proto) 
                            (send object :installed-p))
                       object)))
           *hardware-objects*)))

(defun front-plotcell () *front-plotcell*)

#|
 | FONTS AND DIRECTORIES
 |#

(defun fonts ()
  (setf *font-setting-mode* t)
  (setf *directory-setting-mode* nil)
  (setf *font-and-dir-setting-mode* nil)
  (set-working-directory *startup-dir-name*)
  (load (strcat *runtime-dir-name* "config.lsp")))

(defun directories ()
  (setf *font-setting-mode* nil)
  (setf *directory-setting-mode* t)
  (setf *font-and-dir-setting-mode* nil)
  (set-working-directory *startup-dir-name*)
  (load (strcat *runtime-dir-name* "config.lsp")))

(defun fonts-and-directories ()
  (set-working-directory *startup-dir-name*)
  (setf *font-and-dir-setting-mode* t)
  (load (strcat *runtime-dir-name* "config.lsp"))
  )

(defun only-fonts-and-directories ()
  (set-working-directory *startup-dir-name*)
  (setf *font-setting-mode* t)
  (setf *directory-setting-mode* t)
  (setf *font-and-dir-setting-mode* nil)
  (setf *run-number (1- *run-number*))
  (load (strcat *runtime-dir-name* "config.lsp"))
  )

(defun repair-font () (reinstall-font))

(defun reinstall-font ()
  (save-all-prefs) 
  (set-working-directory (strcat *default-path* "font"))
  (one-button-dialog "You Will Have to ReStart ViSta")
  (system "mtcom32.exe")
  )



(defun font ()
  (let* ((now-font (msw-get-profile-string "Graphics" "Font" *ini-file*))
         (ok-fonts '("Monotype.Com" "Courier" "Courier New" 
                                    "Lucida Console" ))
         (dialog
          (list-dialog 
           (format nil "CURRENT FONT: ~a" now-font)
           ok-fonts
           (list 
            '(change-font "Monotype.Com")
            '(change-font "Courier")
            '(change-font "Courier New")
            '(change-font "Lucida Console")
            )
           :initial (position now-font ok-fonts :test #'equal)
           :title "Choose Font"))
         )
    (defun change-font (font)
      (write-ini-fonts font)
      (send dialog :close)
      (when (two-button-dialog "ViSta Must be Restarted To See the New Font"
                               :first-button "Restart Now" 
                               :second-button "Restart Later")
            (restart-vista)))))


(defun write-ini-fonts (&optional (font "Monotype.Com"))
  (msw-write-profile-string "Listener" "Font"      font *ini-file*)
  (msw-write-profile-string "Listener" "FontSize"  "9"  *ini-file*)
  (msw-write-profile-string "Graphics" "Font"      font *ini-file*)
  (msw-write-profile-string "Graphics" "FontSize"  "9"  *ini-file*)
  (msw-write-profile-string "Printer"  "Font"      font *ini-file*)
  (msw-write-profile-string "Printer"  "FontSize"  "9"  *ini-file*)
  )

#|______________________________________________________________________
 |
 | The definitions of (vista) and (xlisp) override definitions used when ViSta
 | is in the *xlispstat-only* state. The overridden definitions are in 
 | defun0.lsp. The definitions made here must remain here. They cannot
 | be moved outside of the finale function.
 |_______________________________________________________________________
 |#

 (defun startup-defs-vista-xlisp ()
  (defun vista () 
    "Args: none
Shows the ViSta DeskTop"
    (show-desktop))

  (defun xlisp ()
    "Args: none
Exits ViSta and XLispStat and then runs a fresh XLispStat without ViSta. To use XLispStat in its current state within ViSta, use the (xlispstat-window) function. To use a new, unused XLispStat and ViSta, restart ViSta and then use the (xlispstat-window) function."
    (set-working-directory *default-path*)
    (msw-write-profile-string "ViSta" "XLispOnly" "Yes" *ini-file*)
    (setf *xlispstat-only* t)
    (save-all-prefs)
    (save-gui)
    (system "vista.exe")
    (exit))
    )

